home *** CD-ROM | disk | FTP | other *** search
/ Windows Expert / Windows Expert.iso / desktop / om37a.zip / BUTTONS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-14  |  12KB  |  401 lines
  1. {Buttons - Copyright (C) Doug Overmyer 7/1/91}
  2. unit Buttons;
  3. {************************  Interface    ***********************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects,WIN31,ShellAPI;
  6. type
  7.     hDrop=THandle;
  8. type  {OD Button uses internal .bmp resource }
  9. PODButton = ^TODButton;
  10. TODButton = object(TRadioButton)
  11.         HBmp :HBitmap;
  12.       State:Integer;
  13.       X,Y,W,H:Integer;
  14.     constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  15.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  16.     destructor    Done;virtual;
  17.     procedure    DrawItem(var Msg:TMessage);virtual;
  18.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  19. end;
  20.  
  21. PODDButton = ^TODDButton;{OD Button with D&D - .ICO file,extracted icon res, or internal bmp resource}
  22. TODDButton = object(TODButton)
  23.         SourceName:Array[0..79] of Char;
  24.     constructor Init(AParent:PwindowsObject;AnID:Integer;ATitle:PChar;
  25.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  26.     procedure SetupWindow;virtual;
  27.     function CanClose:Boolean;virtual;
  28.     procedure ChangeBMP(BMPFile:PChar);
  29.     procedure GetBMP;virtual;
  30.     procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  31. end;
  32.  
  33. PODGroupBox = ^TODGroupBox;    {Group box for TODButton }
  34. TODGroupBox = object(TGroupBox)
  35.       OldID:Integer;
  36.   constructor Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
  37.       X,Y,W,H:Integer);
  38.     procedure SelectionChanged(NewID:Integer);virtual;
  39. end;
  40.  
  41. PODDGroupBox = ^TODDGroupBox;  {Group box for TODDButton }
  42. TODDGroupBox = object(TODGroupBox)
  43.     procedure SetupWindow;virtual;
  44.   function CanClose:Boolean;virtual;
  45.   procedure WMDropFiles(var Msg:TMessage);virtual wm_First+wm_DropFiles;
  46. end;
  47. {************************  Implementation      **********************}
  48. implementation
  49. const
  50.     SR_RECESSED = 1;
  51.   SR_RAISED   = 0;
  52. {************************  Functions     ****************************}
  53. {************************  DrawHiLites   ****************************}
  54. function DrawHilites(PaintDC:hDC;X1,Y1,X2,Y2,LW,State:Integer):Boolean;
  55. var
  56.   LPts,RPts:Array[0..2] of TPoint;
  57.   Pen1,Pen2,OldPen:HPen;
  58.   Ofs,W,H:Integer;
  59.   OldBrush:HBrush ;
  60. begin
  61.      Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  62.   OldPen := SelectObject(PaintDC,Pen1);
  63.   OldBrush := SelectObject(PaintDC,GetStockObject(null_Brush));
  64.   Rectangle(PaintDC,X1,Y1,X2,Y2);
  65.   SelectObject(PaintDC,OldPen);
  66.   SelectObject(PaintDC,OldBrush);
  67.   DeleteObject(Pen1);
  68.   Ofs := Byte(State = SR_RECESSED) * lw;
  69.  
  70.     LPts[0].x := X1+Ofs;   LPts[0].y := Y2-Ofs;
  71.     LPts[1].x := X1+Ofs;   LPts[1].y := Y1+Ofs;
  72.   LPts[2].x := X2-Ofs;   LPts[2].y := Y1+Ofs;
  73.   RPts[0].x := X1+Ofs;   RPts[0].y := Y2-Ofs;
  74.     RPts[1].x := X2-Ofs;   RPts[1].y := Y2-Ofs;
  75.     RPts[2].x := X2-Ofs;   RPts[2].y := Y1+Ofs;
  76.   if State = SR_RAISED then
  77.       begin
  78.         Pen1 := CreatePen(ps_Solid,LW,$00FFFFFF);
  79.     Pen2 := CreatePen(ps_Solid,LW,$00000000);
  80.     end
  81.   else
  82.       begin
  83.       Pen1 := CreatePen(ps_Solid,LW,$00000000);
  84.         Pen2 := CreatePen(ps_Solid,LW,$00FFFFFF);
  85.     end;
  86.  
  87.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  88.   PolyLine(PaintDC,LPts,3);
  89.   SelectObject(PaintDC,Pen2);
  90.   DeleteObject(Pen1);
  91.   PolyLine(PaintDC,RPts,3);
  92.   SelectObject(PaintDC,OldPen);
  93.   DeleteObject(Pen2);
  94. end;
  95.  
  96. {Courtesy of Neil Rubenstein on CIS}
  97. function ICOtoBMP(FileName:PChar):HBitmap;
  98. {$I-}
  99. type
  100. IcoHeader = Record
  101.     icoReserved0:Word;
  102.   icoResourceType1:Word;
  103.   icoResourceCount:Word;
  104. end;
  105. IcoDescript = Record
  106.     Width,Height,ColorCount:Byte;
  107.   Reserved1:Byte;
  108.   Reserved2,Reserved3:Word;
  109.   icoDIBSize:LongInt;
  110.   icoDIBOffset:LongInt;
  111. end;
  112. var
  113.     F:File;
  114.   iH:IcoHeader;
  115.   iD:icoDescript;
  116.   ImNum,N:Word;
  117.   Buf:Array[0..60] of Char;
  118.   imSize,imOfs:LongInt;
  119.   hNu:hBitmap;
  120.   BI:PBitmapInfo;
  121.   BitData:Pointer;
  122.   Path,Dir,Name,Ext:Array[0..79] of Char;
  123.   DC:hDC;
  124. const
  125.     BISize:Word = sizeof(TBitmapInfoHeader)+16*sizeof(TRGBQuad);
  126.  
  127.     procedure Cleanup;
  128.   begin
  129.     Close(F);
  130.     if IOresult <> 0  then  ;
  131.       if Bitdata <> nil then
  132.         FreeMem(BitData,BI^.bmiHeader.biSizeImage);
  133.     if BI <> nil then FreeMem(BI,BISize);
  134.   end;
  135.  
  136. begin
  137.     IcoToBMP := 0;
  138.   FileSplit(FileName,Dir,Name,Ext);
  139.   StrCat(StrCat(StrCopy(Path,Dir),Name),'.ICO');
  140.   Assign(F,Path);
  141.   Reset(F,1);
  142.   if IOResult <> 0 then Exit;
  143.   BI := Nil;
  144.   bitData := nil;
  145.     BlockRead(F,IH,sizeof(IH));
  146.   if (IOResult <> 0) or (IH.icoReserved0 <> 0) or (IH.icoResourceType1 <> 1) then
  147.       begin
  148.     Cleanup;
  149.     Exit;
  150.     end;
  151.   imNum := IH.icoResourceCount;
  152.   N :=0;imSize := 0;imOfs := 0;
  153.   While (N < imNum) and (imOfs = 0) DO
  154.       begin
  155.     BlockRead(F,ID,sizeof(ID));
  156.     if IOresult <> 0 then
  157.         begin
  158.       Cleanup;
  159.       exit;
  160.       End;
  161.     if (ID.width=32) and (ID.height=32) and (ID.colorCount=16) then
  162.         begin
  163.       imSize := ID.icoDibSize;
  164.       imOfs :=  ID.icoDibOffset;
  165.       end;
  166.     Inc(N);
  167.     end;
  168.   if imOfs <> 0 then
  169.       begin
  170.     GetMem(BI,BISize);
  171.     Seek(F,imOfs);
  172.     BlockRead(F,BI^,BISize);
  173.     with BI^.bmiHeader do
  174.         begin
  175.       biHeight := 32;
  176.       biSizeImage := (biWidth div 2)* biHeight;
  177.       end;
  178.     GetMem(BItData,BI^.bmiHeader.biSizeImage);
  179.     BlockRead(F,bitData^,BI^.bmiHeader.biSizeImage);
  180.     DC:=CreateDC('Display',nil,nil,nil);
  181.     ICOToBMP := CreateDiBitmap(DC,BI^.bmiHeader,cbm_Init,bitData,BI^,DIB_RGB_COLORS);
  182.     DeleteDC(DC);
  183.     end;
  184.   CleanUP;
  185. end;
  186.  
  187. {*****************************  TODButton  *************************}
  188. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  189.        X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  190. begin
  191.     TRadioButton.Init(AParent,AnID,ATitle,X1,Y1,W1,H1,AGroup);
  192.   Attr.Style :=  Attr.Style or bs_OwnerDraw;
  193.   HBmp := LoadBitmap(HInstance,BMP);
  194.   X:= X1;Y:= Y1;H:=H1;W:= W1;
  195.   State := SR_RAISED;
  196. end;
  197.  
  198. destructor    TODButton.Done;
  199. begin
  200.     DeleteObject(HBmp);
  201.     TButton.Done;
  202. end;
  203.  
  204. procedure    TODButton.DrawItem(var Msg:TMessage);
  205. var
  206.     TheDC,MemDC:HDc;
  207.   OldBitMap:HBitMap;
  208.   PDIS :^TDrawItemStruct;
  209.   PenWidth,OffSet:Integer;
  210.   GKS:Integer;
  211. begin
  212.     PDIS := Pointer(Msg.lParam);
  213.   If IsIconic(hWindow) then Exit;
  214.     if Group = NIL then
  215.       begin
  216.       if PDIS^.itemAction = oda_Focus then Exit;
  217.         if ((PDIS^.itemAction and oda_Select ) > 0) and
  218.           ((PDIS^.itemState and ods_Selected) > 0) then
  219.         State := SR_RECESSED else State := SR_RAISED;
  220.       end
  221.   else 
  222.       begin
  223.       GKS := GetKeyState(vk_LButton);
  224.       if (PDIS^.itemAction = oda_DrawEntire)     then
  225.          State := State
  226.       else if (PDIS^.itemAction = oda_Select) and
  227.               (PDIS^.ItemState = ods_Selected + ods_Focus)
  228.           then State := SR_RECESSED
  229.       else if (PDIS^.itemAction = 2) and
  230.               (PDIS^.ItemState = ods_Focus) and (GKS < 0)
  231.           then State := SR_RAISED
  232.       else Exit;
  233.       end;
  234.   Offset := 2;
  235.   PenWidth := OffSet;
  236.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  237.   OldBitMap := SelectObject(MemDC,HBMP);
  238.   if State = SR_RAISED then BitBlt(PDIS^.HDC,0,0,W,H, MemDC,0,0,SrcCopy)
  239.       else BitBlt(PDIS^.HDC,OffSet,OffSet,W,H, MemDC,0,0,SrcCopy);
  240.   SelectObject(MemDC,OldBitMap);
  241.   DeleteDC(MemDC);
  242.   DrawHiLites(PDIS^.hDC,0,0,W,H,1,State)
  243. end;
  244.  
  245. procedure TODButton.WMRButtonDown(var Msg:TMessage);
  246. begin
  247.     SendMessage(Parent^.HWindow,wm_User+wm_RButtonDown,Integer(GetID),0);
  248. end;
  249. {********************* TODDButton  *****************************}
  250. constructor TODDButton.Init(AParent:PwindowsObject;AnID:Integer;ATitle:PChar;
  251.       X1,Y1,W1,H1:Integer;IsDefault:Boolean;BMP:PChar;AGroup:PGroupBox);
  252. begin
  253.     TODButton.Init(AParent,AnId,ATitle,X1,Y1,W1,H1,IsDefault,'',AGroup);
  254.   if BMP <> NiL then
  255.       StrCopy(SourceName,BMP)
  256.     else StrCopy(SourceName,'');
  257. end;
  258.  
  259. procedure TODDButton.SetupWindow;
  260. begin
  261.     TODButton.SetupWindow;
  262.   DragAcceptFiles(HWindow,TRUE);
  263.     GetBMP;
  264. end;
  265.  
  266. function TODDButton.CanClose:Boolean;
  267. begin
  268.     DragAcceptFiles(HWindow,FALSE);
  269.     CanClose := TODButton.CanClose;
  270. end;
  271.  
  272. procedure TODDButton.WMDropFiles(var Msg:TMessage);
  273. var
  274.     DropItem:hDrop;
  275.   FileNameBuf:Array[0..fsPathName] of Char;
  276.   NewIcon:hIcon;
  277.   GFileName:PChar;
  278.   CtrlID:Integer;
  279. begin
  280.     DropItem := Msg.wParam;
  281.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  282.   GFileName :=StrNew(FileNameBuf);
  283.   StrCopy(SourceName,FileNameBuf);
  284.   GetBMP;
  285.   DragFinish(DropItem);
  286.   CtrlID := GetID;
  287.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  288.   StrDispose(GFileName);
  289. end;
  290.  
  291. procedure TODDButton.ChangeBMP(BMPFile:PChar);
  292. begin
  293.   StrCopy(SourceName,BMPFile);
  294.   GetBMP;
  295. end;
  296.  
  297. procedure TODDButton.GetBMP;
  298. var
  299.   Icon:hIcon;
  300.   MemDC,MemDC2,DC:HDC;
  301.   OldBmp,OldBMP2:HBitmap;
  302.   OldBrush:HBrush;
  303.   DIBmp:HBitmap ;
  304. begin
  305.     if HBmp > 0 then DeleteObject(HBmp);
  306.     Icon := 0; DIBmp := 0; HBmp := 0;
  307.   Icon := ExtractIcon(HInstance,SourceName,0);  {try to get an icon out of source}
  308.   if Icon < 2 then                              {well, see if it's an .ICO file}
  309.       DIBmp := ICOtoBMP(SourceName);
  310.   if DiBmp = 0 then                             {last resort - see if it's an internal resource}
  311.       DIBmp :=LoadBitmap(HInstance,SourceName);
  312.   DC := GetDC(HWindow);
  313.   hBmp := CreateCompatibleBitmap(DC,W,H);
  314.   MemDC := CreateCompatibleDC(DC);
  315.   OldBmp := SelectObject(MemDC,hBmp);
  316.   OldBrush := SelectObject(MemDC,GetStockObject(ltGray_Brush));
  317.   PatBlt(MemDC,0,0,Pred(W),Pred(H),PatCopy);
  318.   if Icon >1 then
  319.       DrawIcon(MemDC,1,1,Icon)
  320.   else if DIBmp >0 then
  321.       begin
  322.     MemDC2 := CreateCompatibleDC(DC);
  323.     OldBmp2 :=SelectObject(MemDC2,DIBmp);
  324.       BitBlt(MemDC,1,1,Pred(W),Pred(H),MemDC2,0,0,SrcCopy);
  325.     SelectObject(MemDC2,OldBmp2);
  326.     DeleteObject(DIBmp);
  327.     DeleteDC(MemDC2);
  328.     end
  329.   else
  330.       Rectangle(MemDC,0,0,W,H);
  331.   SelectObject(MemDC,OldBmp);
  332.   SelectObject(MemDC,OldBrush);
  333.   DeleteDC(MemDC);
  334.   ReleaseDC(hWindow,DC);
  335.   InvalidateRect(HWindow,nil,True);
  336. {  UpdateWindow(HWindow); }
  337. end;
  338. {******************  TODGroupBox   ******************************}
  339. constructor TODGroupBox.Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
  340.       X,Y,W,H:Integer);
  341. begin
  342.     TGroupBox.Init(AParent,AnId,AText,X,Y,W,H);
  343.   Attr.Style := Attr.Style {and not ws_Visible};
  344.   OldID := 0;
  345. end;
  346.  
  347. procedure TODGroupBox.SelectionChanged(NewID:Integer);
  348. begin
  349.     TGroupBox.SelectionChanged(NewID);
  350.   if NewID = OldID then
  351.       Exit;
  352.     If OldID = 0 then
  353.     OldID := NewID
  354.   else
  355.       begin
  356.     PODButton(Parent^.ChildWithID(OldID))^.State := SR_RAISED;
  357.     InvalidateRect(Parent^.ChildWithID(OldID)^.HWindow,nil,True);
  358.     OldID := NewID;
  359.     end;
  360. end;
  361. {*************************  TODDGroupBox     **************************}
  362. procedure TODDGroupBox.SetupWindow;
  363. begin
  364.     TODGroupBox.SetupWindow;
  365.   DragAcceptFiles(HWindow,TRUE);
  366.   SetClassWord(HWindow,GCW_HBRBACKGROUND,GetStockObject(LTGRAY_BRUSH));
  367. end;
  368.  
  369. function TODDGroupBox.CanClose:Boolean;
  370. begin
  371.     DragAcceptFiles(HWindow,FALSE);
  372.     CanClose := TGroupBox.CanClose;
  373. end;
  374.  
  375. procedure TODDGroupBox.WMDropFiles(var Msg:TMessage);
  376. var
  377.     DropItem:hDrop;
  378.   FileNameBuf:Array[0..fsPathName] of Char;
  379.   NewIcon:hIcon;
  380.   MemDC,DC:HDC;
  381.   OldBmp,NewBmp:HBitmap;
  382.   OldBrush:HBrush;
  383.   GFileName:PChar;
  384.   CtrlID:Integer;
  385.   Loc,SLoc:TPoint;
  386.   ChildWin:HWnd;
  387. begin
  388.     DropItem := Msg.wParam;
  389.   DragQueryFile(DropItem,0,FileNameBuf,sizeof(FileNameBuf));
  390.   GFileName :=StrNew(FileNameBuf);
  391.   DragQueryPoint(DropItem,Loc);
  392.   DragFinish(DropItem);
  393.   SLoc := Loc;
  394.   ClienttoScreen(HWindow,SLoc);
  395.   ChildWin := WindowFromPoint(SLoc);
  396.   CtrlID := GetDlgCtrlID(ChildWin);
  397.   SendMessage(Parent^.HWindow,wm_User+wm_DropFiles,CtrlID,LongInt(GFileName));
  398.   StrDispose(GFileName);
  399. end;
  400. end.
  401.